home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / basics / stamps.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  2.5 KB  |  78 lines
  1. (* Copyright 1990, 1991 by AT&T Bell Laboratories *)
  2. (* stamps.sml *)
  3.  
  4. abstraction Stamps : STAMPS =
  5. struct
  6.  
  7.   type boundscope = int ref
  8.   datatype scope = FREESCOPE
  9.                  | BOUNDSCOPE of boundscope
  10.   
  11.   datatype stamp =
  12.       BOUND of boundscope * int 
  13.     | GENFREE of PersStamps.persstamp  (* only found in signatures *)
  14.     | FREE of PersStamps.persstamp
  15.     | NULL
  16.     | ERROR
  17.  
  18.   val nextStamp = ref 1
  19.   val nextBoundScope = ref 1
  20.  
  21.   val freeScope = FREESCOPE
  22.  
  23.   fun newBoundScope () =
  24.           BOUNDSCOPE (ref (!nextBoundScope)) before inc nextBoundScope
  25.  
  26.   fun newStamp FREESCOPE = 
  27.           (fn () => FREE(PersStamps.newStamp()))
  28.     | newStamp (BOUNDSCOPE s) =
  29.           (fn () => BOUND(s,(!nextStamp before inc nextStamp)))
  30.  
  31.   fun newGenStamp FREESCOPE = 
  32.           (fn () => GENFREE(PersStamps.newStamp()))
  33.     | newGenStamp (BOUNDSCOPE s) =
  34.           (fn () => BOUND(s,(!nextStamp before inc nextStamp)))
  35.  
  36.   val newFree = newStamp FREESCOPE
  37.  
  38.   val null = NULL
  39.   val error = ERROR
  40.  
  41.   fun isBound FREESCOPE = (fn FREE _ => true | _ => false)
  42.     | isBound (BOUNDSCOPE s) = (fn BOUND(s',_) => s=s' | _ => false)
  43.  
  44.   fun less (BOUND(s1,n1), BOUND(s2,n2)) =
  45.       if s1 <> s2 then ErrorMsg.impossible "Stamps.less -- scopes"
  46.       else n1 < n2
  47.     | less (FREE s1,FREE s2) = PersStamps.less (s1,s2)
  48.     | less _ =  ErrorMsg.impossible "Stamps.less - bad arg"
  49.  
  50.   fun greater (BOUND(s1,n1), BOUND(s2,n2)) =
  51.       if s1 <> s2 then ErrorMsg.impossible "Stamps.greater -- scopes"
  52.       else n1 > n2
  53.     | greater (FREE s1,FREE s2) = PersStamps.greater(s1,s2)
  54.     | greater _ = ErrorMsg.impossible "Stamps.greater - bad arg"
  55.  
  56.   val stampToString =
  57.       fn BOUND(ref i,j) => "BOUND(scope="^makestring i^
  58.                              ",stamp="^makestring j^")"
  59.        | FREE i => "FREE("^PersStamps.stampToString i^")"
  60.        | GENFREE i => "GENFREE("^PersStamps.stampToString i^")"
  61.        | NULL => "NULL"
  62.        | ERROR => "ERROR"
  63.  
  64.   abstype 'a stampMap = STAMPMAP of ('a Intmap.intmap * 'a PersStamps.stampMap)
  65.   with
  66.      fun newMap ex = STAMPMAP(Intmap.new (20, ex),PersStamps.newMap ex)
  67.  
  68.      fun updateMap (STAMPMAP (map,_)) (BOUND(_,st),v) = Intmap.add map (st, v)
  69.        | updateMap (STAMPMAP (_,map)) (FREE st,v) = PersStamps.updateMap map (st, v)
  70.        | updateMap _ _ = ErrorMsg.impossible "Stamps.updateMap"
  71.  
  72.      fun applyMap (STAMPMAP (map,_), BOUND (_,s)) = Intmap.map map s
  73.        | applyMap (STAMPMAP (_,map), FREE s) = PersStamps.applyMap (map,s)
  74.        | applyMap _ = ErrorMsg.impossible "Stamps.applyMap"
  75.   end
  76.     
  77. end (* structure Stamps *)
  78.